home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / Drivers / MemBoardTest.lha / MemBoardTest / supertest.mod < prev    next >
Encoding:
Modula Implementation  |  1988-10-02  |  7.5 KB  |  241 lines
  1.  
  2.  
  3. IMPLEMENTATION MODULE supertest;
  4.  
  5.  
  6. FROM RandomNumbers IMPORT Seed,Random;
  7. FROM InOut IMPORT WriteLn,WriteString,ReadString,WriteInt,WriteCard;
  8. FROM Strings IMPORT String,Length,Concat;
  9. FROM SYSTEM IMPORT ADDRESS,WORD,NULL,ADR;
  10. IMPORT Terminal; (* conflict with DOSFiles.Write *)
  11. FROM Pens IMPORT SetAPen,SetDrMd,Move;
  12. FROM Text IMPORT Text;
  13. FROM myscreen IMPORT RP, ourwindow;
  14. FROM mtest IMPORT HexChar,Convert,ConvertChar, WriteHex;
  15. FROM mdraw IMPORT drawpixel,drawstats,addressbits,databits;   
  16. FROM Rasters IMPORT ScrollRaster;
  17. FROM Intuition IMPORT IntuiMessagePtr, IDCMPFlags, IDCMPFlagSet, 
  18.                       SelectDown, MenuDown;
  19. FROM Ports IMPORT GetMsg, ReplyMsg, MessagePtr, WaitPort;
  20. FROM DOSFiles IMPORT Open,Close,Write,FileHandle,ModeNewFile;
  21.  
  22.  
  23. VAR  j,maxvalue,redcard,valuecard:CARDINAL;
  24.      addresscard : LONGCARD;
  25.      response, stringA, stringB, endofline:String;
  26.      i,errorlimit:INTEGER;
  27.      start,end:ADDRESS;
  28.      startmessage,endmessage : String;
  29.      mesg : IntuiMessagePtr;
  30.      actual : LONGINT;
  31.      myfile : FileHandle;
  32.      bitarray : ARRAY[0..15] OF WORD;
  33.      class : IDCMPFlagSet;
  34.      code,bit : CARDINAL;
  35.  
  36. PROCEDURE DoSuperBits(start,end:ADDRESS;
  37.                  errorlimit:INTEGER; 
  38.                  save,dowrite,message:BOOLEAN);
  39.  
  40.    VAR i:ADDRESS;
  41.        value:WORD;
  42.        errors:INTEGER;
  43.        quit, currenterror:BOOLEAN;
  44.  
  45.    BEGIN
  46.       SetAPen(RP,4);
  47.       Move(RP,30,280);
  48.       Text(RP,startmessage,16);
  49.  
  50.       FOR j := 0 TO 23 DO
  51.          addressbits[j] := 0;
  52.          END; (* for *)
  53.          
  54.       FOR j := 0 TO 15 DO
  55.          databits[j] := 0;
  56.          END; (* for *)
  57.  
  58.       IF save THEN
  59.          myfile := Open('ramerr',ModeNewFile);
  60.          END; (* if *);
  61.  
  62.       mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
  63.       WHILE mesg#NULL DO 
  64.          mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
  65.          END; (* while *)
  66.  
  67.       SetAPen(RP,2); (* blue *)
  68.       ScrollRaster(RP,0,10,0,300,639,399);
  69.       ScrollRaster(RP,0,10,0,300,639,399);
  70.       ScrollRaster(RP,0,10,0,300,639,399);
  71.       ScrollRaster(RP,0,10,0,300,639,399);
  72.       ScrollRaster(RP,0,10,0,300,639,399);
  73.       Move(RP,20,370);
  74.       Text(RP,
  75.            '     --------- CLICK LEFT MOUSE BUTTON TO STOP ---------   ',
  76.            50);
  77.       Move(RP,20,380);
  78.       Text(RP,
  79.            '     --------- HOLD RIGHT MOUSE BUTTON TO PAUSE --------   ',
  80.            50);
  81.  
  82.       i:=start;
  83.       drawpixel(i,6);
  84.       errors:=0;
  85.       quit:=FALSE;
  86.       currenterror:=FALSE;
  87.       WHILE (i<=end) AND (errors<errorlimit) AND NOT quit DO
  88.          bit:= 0;
  89.          LOOP
  90.             IF (bit>15) OR quit THEN
  91.                EXIT;
  92.                END; (* if *)
  93.             i^:=bitarray[bit];
  94.  
  95.             value:=WORD(i^);
  96.             IF CARDINAL(value) # CARDINAL(bitarray[bit]) THEN
  97.                currenterror:=TRUE;
  98.                IF save OR message THEN
  99.                   stringA := 'BAD Location, address - ';
  100.  
  101.                   WriteHex(CARDINAL(i DIV 65536),stringA,stringB);
  102.                   WriteHex(CARDINAL(i MOD 65536),stringB,stringA);
  103.    
  104.                   Concat(stringA,'H  Written - ',stringB);
  105.     
  106.                   WriteHex(CARDINAL(bitarray[bit]),stringB,stringA);
  107.  
  108.                   Concat(stringA,'H  Read - ',stringB);
  109.   
  110.                   WriteHex(CARDINAL(value),stringB,stringA);
  111.  
  112.                   Concat(stringA,'H',stringB);
  113.                   END; (* if *)
  114.  
  115.                IF message THEN
  116.                   SetAPen(RP,3);
  117.                   ScrollRaster(RP,0,10,0,300,639,399);
  118.                   Move(RP,20,380);
  119.                   Text(RP,stringB,Length(stringB));
  120.                   END; (* if *)
  121.  
  122.                IF save AND (myfile<>LONGCARD(0)) THEN
  123.                   Concat(stringB,endofline,stringA);
  124.                   actual := Write(myfile,ADR(stringA),LONGCARD(Length(stringA)));
  125.                   END; (* if *)
  126.  
  127.                INC(errors);
  128.  
  129.                drawpixel(i,3);
  130.  
  131. (*               WriteString('mark 1');
  132.                WriteLn;*)
  133.                
  134.                addresscard := LONGCARD(i);
  135.                FOR j:= 0 TO 23 DO
  136.                   IF addresscard MOD 2 > 0 THEN
  137.                      INC(addressbits[j]);
  138.                      END; (* if *)
  139.                   addresscard := addresscard DIV 2;
  140.                   END; (* for *)
  141.               
  142.                valuecard := CARDINAL(i DIV 2);
  143.                redcard   := CARDINAL(value);
  144.              
  145.                FOR j:= 0 TO 15 DO
  146.                   IF (valuecard MOD 2) # (redcard MOD 2) THEN
  147.                      INC(databits[j]);
  148.                      END; (* if *)
  149.                   valuecard := valuecard DIV 2;
  150.                   redcard   := redcard   DIV 2;
  151.                   END; (* for *)
  152.  
  153. (*               WriteString('mark 2');
  154.                WriteLn;*)
  155.                
  156.                mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
  157.                IF mesg # NULL THEN (* user wants to quit *)
  158.                   class:=mesg^.Class;
  159.                   code :=mesg^.Code;
  160.  
  161. (*                  WriteString('mark 3');
  162.                   WriteLn;*)
  163.  
  164.                   IF IDCMPFlags(MouseButtons) IN class THEN
  165.                      IF SelectDown = code THEN
  166. (*                        WriteString('Selectdown detected and replied');
  167.                         WriteLn;*)
  168.                         ReplyMsg(MessagePtr(mesg));
  169.                         quit:=TRUE;
  170.                         SetAPen(RP,2); (* blue *)
  171.                         ScrollRaster(RP,0,10,0,300,639,399);
  172.                         Move(RP,20,380);
  173.                         Text(RP,
  174.                              '     -------- OPERATION ABORTED BY USER --------   ',
  175.                              50);
  176.                      ELSIF MenuDown = code THEN
  177. (*                        WriteString('MenuDown detected and replied');
  178.                         WriteLn;*)
  179.                         ReplyMsg(MessagePtr(mesg));
  180.                         mesg:=IntuiMessagePtr(WaitPort(ourwindow^.UserPort));
  181.                         WHILE mesg # NULL DO
  182.                            mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
  183.                            END; (* while *)
  184.                         END; (* elsif *)
  185.                   ELSE
  186.                      ReplyMsg(MessagePtr(mesg));
  187. (*                     WriteString('Non mouse message recieved and replied');
  188.                      WriteLn;*)
  189.                      END; (* else *)
  190.  
  191.                   END; (* if received intuimessage *)                   
  192.                     
  193.                END; (* if not same then *)
  194.  
  195.             INC(bit,1);
  196.             END; (* loop from bit 0 to 15 *)
  197.          
  198.          INC(i,2);
  199.          IF i MOD 65536 = 0 THEN
  200.             drawpixel(i,6);
  201.             IF currenterror THEN
  202.                drawpixel(ADDRESS(LONGCARD(i)-10),2);
  203.                currenterror:=FALSE;
  204.                END; (* if *)
  205.             mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
  206.             IF mesg#NULL THEN (* user wants to quit *)
  207.                ReplyMsg(MessagePtr(mesg));
  208.                quit := TRUE;
  209.                END; (* if *)  
  210.             END; (* if *)
  211.  
  212.          END; (* while not quit and still in range *)
  213.  
  214.      IF save AND (myfile<>LONGCARD(0)) THEN
  215.         Close(myfile);
  216.         END; (* if *)
  217.  
  218.      drawstats;
  219.  
  220.      SetAPen(RP,4);
  221.      Move(RP,30,280);
  222.      Text(RP,endmessage,16);
  223.   END DoSuperBits;         
  224.  
  225.  
  226.  
  227.  
  228. BEGIN (* memorytest *)
  229.    startmessage := 'Doing Test Now...';
  230.    endmessage   := 'Test Completed.  ';
  231.    endofline[0] := CHR(10);
  232.    endofline[1] := CHR(0);
  233.  
  234.    bitarray[0] := WORD(1);
  235.    FOR j:=1 TO 15 DO
  236.       bitarray[j]:=WORD(CARDINAL(bitarray[j-1])*2);
  237.       END; (* for *);
  238.  
  239. END supertest.
  240.  
  241.